home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / t / op / avhv.t < prev    next >
Text File  |  1998-07-14  |  2KB  |  111 lines
  1. #!./perl
  2.       
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     @INC = '../lib';
  6. }
  7.  
  8. require Tie::Array;
  9.  
  10. package Tie::BasicArray;
  11. @ISA = 'Tie::Array';
  12. sub TIEARRAY  { bless [], $_[0] }
  13. sub STORE     { $_[0]->[$_[1]] = $_[2] }
  14. sub FETCH     { $_[0]->[$_[1]] }
  15. sub FETCHSIZE { scalar(@{$_[0]})} 
  16. sub STORESIZE { $#{$_[0]} = $_[1]+1 } 
  17.  
  18. package main;
  19.  
  20. print "1..12\n";
  21.  
  22. $sch = {
  23.     'abc' => 1,
  24.     'def' => 2,
  25.     'jkl' => 3,
  26. };
  27.  
  28. # basic normal array
  29. $a = [];
  30. $a->[0] = $sch;
  31.  
  32. $a->{'abc'} = 'ABC';
  33. $a->{'def'} = 'DEF';
  34. $a->{'jkl'} = 'JKL';
  35.  
  36. @keys = keys %$a;
  37. @values = values %$a;
  38.  
  39. if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
  40.  
  41. $i = 0;        # stop -w complaints
  42.  
  43. while (($key,$value) = each %$a) {
  44.     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
  45.     $key =~ y/a-z/A-Z/;
  46.     $i++ if $key eq $value;
  47.     }
  48. }
  49.  
  50. if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
  51.  
  52. # quick check with tied array
  53. tie @fake, 'Tie::StdArray';
  54. $a = \@fake;
  55. $a->[0] = $sch;
  56.  
  57. $a->{'abc'} = 'ABC';
  58. if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
  59.  
  60. # quick check with tied array
  61. tie @fake, 'Tie::BasicArray';
  62. $a = \@fake;
  63. $a->[0] = $sch;
  64.  
  65. $a->{'abc'} = 'ABC';
  66. if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
  67.  
  68. # quick check with tied array & tied hash
  69. require Tie::Hash;
  70. tie %fake, Tie::StdHash;
  71. %fake = %$sch;
  72. $a->[0] = \%fake;
  73.  
  74. $a->{'abc'} = 'ABC';
  75. if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
  76.  
  77. # hash slice
  78. my $slice = join('', 'x',@$a{'abc','def'},'x');
  79. print "not " if $slice ne 'xABCx';
  80. print "ok 6\n";
  81.  
  82. # evaluation in scalar context
  83. my $avhv = [{}];
  84. print "not " if %$avhv;
  85. print "ok 7\n";
  86.  
  87. push @$avhv, "a";
  88. print "not " if %$avhv;
  89. print "ok 8\n";
  90.  
  91. $avhv = [];
  92. eval { $a = %$avhv };
  93. print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
  94. print "ok 9\n";
  95.  
  96. $avhv = [{foo=>1, bar=>2}];
  97. print "not " unless %$avhv =~ m,^\d+/\d+,;
  98. print "ok 10\n";
  99.  
  100. # check if defelem magic works
  101. sub f {
  102.     print "not " unless $_[0] eq 'a';
  103.     $_[0] = 'b';
  104.     print "ok 11\n";
  105. }
  106. $a = [{key => 1}, 'a'];
  107. f($a->{key});
  108. print "not " unless $a->[1] eq 'b';
  109. print "ok 12\n";
  110.  
  111.